home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / src / dump.c < prev    next >
C/C++ Source or Header  |  1992-10-21  |  2KB  |  92 lines
  1. #include "scheme.h"
  2.  
  3. #ifdef CAN_DUMP
  4.  
  5. #include <errno.h>
  6. #include <sys/types.h>
  7. #include <sys/stat.h>
  8.  
  9. extern int errno;
  10.  
  11. Object Dump_Control_Point;
  12.  
  13. Init_Dump () {
  14.     Global_GC_Link (Dump_Control_Point);
  15. }
  16.  
  17. #define Dump_Prolog \
  18.     Object ret;\
  19.     int ofd, afd;\
  20.     FILE *fp;\
  21.     char *ofn;\
  22.     Declare_C_Strings;\
  23.     GC_Node;\
  24. \
  25.     if (!EQ (Curr_Input_Port, Standard_Input_Port) ||\
  26.         !EQ (Curr_Output_Port, Standard_Output_Port))\
  27.     Primitive_Error ("cannot dump with current ports redirected");\
  28.     Flush_Output (Curr_Output_Port);\
  29.     Close_All_Files ();\
  30. \
  31.     GC_Link (ofile);\
  32.     ret = Internal_Call_CC (1, Null);\
  33.     if (Truep (ret))\
  34.     return ret;\
  35.     GC_Unlink;\
  36. \
  37.     Disable_Interrupts;\
  38. \
  39.     Make_C_String (ofile, ofn);\
  40.     if ((fp = fopen (ofn, "w+")) == 0) {\
  41.     Saved_Errno = errno;\
  42.     Primitive_Error ("cannot open ~s: ~E", ofile);\
  43.     }\
  44.     ofd = dup (fileno (fp));\
  45.     (void)fclose (fp);\
  46.     if (ofd == -1)\
  47.     Primitive_Error ("out of file descriptors");\
  48.     if ((afd = open (A_Out_Name, 0)) == -1) {\
  49.     Saved_Errno = errno;\
  50.     close (ofd);\
  51.     Primitive_Error ("cannot open a.out file: ~E");\
  52.     }
  53.  
  54. #define Dump_Finalize    Saved_Errno = errno; close (afd); close (ofd)
  55.     
  56.  
  57. #define Dump_Epilog {\
  58.     close (afd);\
  59.     Set_File_Executable (ofd, ofn);\
  60.     close (ofd);\
  61.     Enable_Interrupts;\
  62.     Dispose_C_Strings;\
  63.     return False;\
  64. }
  65.  
  66. #ifdef ELF
  67. #  include "dump.elf.c"
  68. #else
  69. #ifdef ECOFF
  70. #  include "dump.ecoff.c"
  71. #else
  72. #  include "dump.vanilla.c"
  73. #endif
  74. #endif
  75.  
  76. /*ARGSUSED1*/
  77. Set_File_Executable (fd, fn) int fd; char *fn; {
  78.     struct stat st;
  79.  
  80.     if (fstat (fd, &st) != -1) {
  81.     int omask = umask (0);
  82.     (void)umask (omask);
  83. #ifdef FCHMOD_BROKEN
  84.     (void)chmod (fn, st.st_mode & 0777 | 0111 & ~omask);
  85. #else
  86.     (void)fchmod (fd, st.st_mode & 0777 | 0111 & ~omask);
  87. #endif
  88.     }
  89. }
  90.  
  91. #endif /* CAN_DUMP */
  92.